home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / pow_tb.zip / TBFILT1.PRG < prev    next >
Text File  |  1993-05-14  |  4KB  |  164 lines
  1.    /* tbFilt1.prg: A simple filtered browse of supplier.dbf.
  2.    
  3.    Uses the fact that the database is indexed on supplier->name,and 
  4.    that therefore all records to be "passed" by the filter will be 
  5.    together in a block. Cursor movement blocks goTopBlock, 
  6.    goBottomBlock and skipBlock are then used to maintain the cursor
  7.    within that block.
  8.    
  9.    Copyright (C) Dave Boettcher 1993. This source code, and functional 
  10.    fragments thereof, may only be distributed unchanged and as part of 
  11.    the file POWER_TB.ARJ. See POWER_TB.TXT for full copyright details.
  12.    
  13.    Last change:  14 May 93       6:49 pm
  14.    */
  15.    
  16.    #include "setcurs.ch"
  17.    #include "inkey.ch"
  18.    #include "box.ch"
  19.    
  20. function main()
  21.    
  22.    local oBrowse
  23.    local oColumn
  24.    local nKey
  25.    local lCont := .T.
  26.    local oldColour := setcolor("w+/b")
  27.    local oldCursor := setcursor(SC_NONE)
  28.    
  29.    local cScope := "Nantucket UK Ltd"   
  30.    local bScope := {|| upper(alltrim(supplier->name)) == upper(cScope) }
  31.    
  32.    use supplier new
  33.    index on supplier->name to supplier
  34.    goTop(cScope)
  35.    
  36.    clear screen
  37.    @ 0, 0, 24, 79 box B_DOUBLE   
  38.    
  39.    oBrowse := tbrowsedb(1, 1, 23, 78)
  40.    oBrowse:headsep   := "─┬─"
  41.    oBrowse:colsep    := " │ "
  42.    oBrowse:goTopBlock := {|| goTop(cScope) }
  43.    oBrowse:goBottomBlock := {|| goBottom(cScope) }
  44.    oBrowse:skipBlock := {|x| Skipper(x, bScope) }
  45.    
  46.    oColumn := TBColumnNew("Name", {|| supplier->name})
  47.    oColumn:width := 20
  48.    oColumn:footsep := "─┴─"
  49.    oBrowse:AddColumn(oColumn)
  50.    
  51.    oColumn := TBColumnNew("Street", {|| supplier->street})
  52.    oColumn:width := 20 
  53.    oColumn:footsep := "─┴─"
  54.    oBrowse:AddColumn(oColumn)
  55.    
  56.    oColumn := TBColumnNew("Town", {|| supplier->town})
  57.    oColumn:width := 20
  58.    oColumn:footsep := "─┴─"
  59.    oBrowse:AddColumn(oColumn)
  60.    
  61.    oColumn := TBColumnNew("County", {|| supplier->county})
  62.    oColumn:width := 20
  63.    oColumn:footsep := "─┴─"
  64.    oBrowse:AddColumn(oColumn)
  65.    
  66.    oColumn := TBColumnNew("Postcode", {|| supplier->product})
  67.    oColumn:width := 7
  68.    oColumn:footsep := "─┴─"
  69.    oBrowse:AddColumn(oColumn)
  70.    
  71.    oColumn := TBColumnNew("Product", {|| supplier->product})
  72.    oColumn:width := 250
  73.    oColumn:footsep := "─┴─"
  74.    oBrowse:AddColumn(oColumn)
  75.    
  76.    do while lCont
  77.       
  78.       do while .not. oBrowse:stable .AND. (nKey := InKey()) == 0
  79.          oBrowse:Stabilize()
  80.       enddo
  81.       
  82.       if oBrowse:stable
  83.          if (oBrowse:hitTop .OR. oBrowse:hitBottom)
  84.             Tone(125,0)
  85.          endif
  86.          nKey := InKey(0)
  87.       endif
  88.       
  89.       Do Case
  90.          Case nKey == K_DOWN        ;  oBrowse:Down()
  91.          Case nKey == K_UP          ;  oBrowse:Up()
  92.          Case nKey == K_LEFT        ;  oBrowse:Left()
  93.          Case nKey == K_RIGHT       ;  oBrowse:Right()
  94.          Case nKey == K_PGDN        ;  oBrowse:PageDown()
  95.          Case nKey == K_PGUP        ;  oBrowse:PageUp()
  96.          Case nKey == K_CTRL_PGUP   ;  oBrowse:GoTop()
  97.          Case nKey == K_CTRL_PGDN   ;  oBrowse:GoBottom()
  98.          Case nKey == K_ESC         ;  lCont := .F.
  99.       endcase
  100.       
  101.    enddo
  102.    
  103.    setcolor(oldColour)
  104.    setcursor(oldCursor)
  105.    clear screen
  106.    
  107.    return nil
  108.    
  109.    
  110. function gotop(cScope)
  111.    
  112.    seek cScope   
  113.    
  114.    return nil
  115.    
  116.    
  117. function gobottom(cScope)
  118.    
  119.    local searcher
  120.    
  121.    searcher := substr(cScope,1,len(cScope)-1)+chr(asc(right(cScope,1))+1)
  122.    dbseek(searcher, .t.)
  123.    skip -1
  124.    
  125.    return nil     
  126.    
  127.    
  128. function skipper( nRequested, bscope )
  129.    
  130.    local nAllowed := 0
  131.    
  132.    do case
  133.          
  134.       case nRequested == 0
  135.          skip 0
  136.          
  137.       case nRequested > 0
  138.          do while eval(bScope) .and. !eof() .and. nAllowed < nRequested
  139.             skip 1
  140.             nAllowed++
  141.          enddo
  142.          
  143.          if !eval(bScope) .or. eof()
  144.             nAllowed--
  145.             skip -1
  146.          endif
  147.          
  148.       case nRequested < 0
  149.          do while eval(bScope) .and. !bof() .and. nAllowed > nRequested
  150.             skip -1
  151.             nAllowed--
  152.          enddo
  153.          
  154.          if !eval(bScope)
  155.             nAllowed++
  156.             skip 1
  157.          elseif bof()
  158.             nAllowed++
  159.          endif
  160.          
  161.    endcase
  162.    
  163.    return (nAllowed)
  164.